home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / seabool2.zip / SEABOOL.PAS < prev    next >
Pascal/Delphi Source File  |  1990-02-16  |  34KB  |  917 lines
  1. unit seabool; {COPYRIGHT 1990 by Peter Neuendorffer}
  2. {compiler options: BOOLEAN SHORT CIRCUIT SHOULD BE ON}
  3.                    {STACK CHECKING MUST BE ON}
  4.                    {IF USING EDITSTRING OR LOWERCASE,
  5.                        RELAXED STRING CHECKING MUST BE SET}
  6.  
  7. {CHANGES SEABOOL VERSION 1.1:
  8.  bool_validation_sit codes sorted better
  9.     2=invalid- too complicated or wrong syntax for condition
  10.     4=logically never true
  11.     -------------------------
  12.     range test corrected in lowercase}
  13. interface
  14. const
  15.   punct = [')','(',' '];
  16. type
  17.   letter_type = 'a'..#123;
  18.   hash_function_type=function :boolean;                  {type parity for
  19.                                                    procedural parameter}
  20.   hash_procedure_type=procedure(var internal_string :string;var valid:boolean);
  21.  
  22.   {for any_bool unit code}
  23. var
  24. and_op,or_op :boolean;
  25.  
  26.  
  27.   bool_recursion_depth_0 : byte;                  {for fence routine}
  28.   max_bool_recursion_depth: byte;                 {when recursion is}
  29.                                                   {deemed too deep}
  30.  
  31.  
  32.   bool_validation_sit : byte; {REFLECTS STATUS OF USER_BOOLEAN STRING}
  33.                              {1=ok,2=bad,
  34.                               4=always_false,100=not initialized
  35.  
  36.                                 User must call bool_init for each new
  37.                                 boolean string at least once before
  38.                                 actual first call to bool() for that
  39.                                    boolean string!}
  40.  
  41.  
  42. {ARRAY OF CURRENT BOOLEAN VARIABLES}
  43. search_object_hash_table_0 : array [letter_type] of
  44.                                                     string;
  45.  
  46.  length_object_hash_table_0 : letter_type;
  47.                       {this hash table contains a list of all valid
  48.                           string primary search objects within a
  49.                           given boolean search string. This table
  50.                           is set and used during bool_init function
  51.                              to return the bool_validation_sit analysis
  52.                              code of the boolean target string provided
  53.                              by the end-user.}
  54.  
  55.  current_object_hash_table_index_0 : 'a'..'z'; {where in history table we
  56.                                               are when translating to
  57.                                                  symbolics}
  58.  
  59.  
  60. {SMART LINK VARIABLES:}
  61.  test_source_string:string;
  62.  bool_crit_true : array['a'..#123] of boolean;{note however,
  63.                                     this array only valid after
  64.                                     call to bool_init, and for
  65.                               possible indexes 'b'..'y'}
  66.  critical_test_letter: letter_type;
  67.  
  68. {------------------------------------------------------}
  69. {TWO INTERFACE CALLS FOR BOOLEAN ENGINE::::}
  70. procedure bool_init(user_boolean_string : string);
  71. function any_bool(user_defined_procedure : hash_procedure_type) :boolean;
  72.  
  73. {------------------------------------------------------}
  74. procedure Editstring ( var newstring : string);
  75. function Lowercase(convert_string : string) :string;
  76.                          {converts a string to lowercase}
  77.  
  78.  
  79.  
  80.  
  81. implementation
  82.  
  83. {RELATED SERVICES editstring and lowercase}
  84.  
  85. procedure Editstring ( var newstring : string);
  86. type
  87.   byte_array_string_typcast = array[1..257] of byte;
  88.  
  89.   var
  90.     letter    : integer;
  91.     allspaces, finished
  92.               : boolean;
  93.   newstring_byte_pointer :^byte_array_string_typcast;
  94.  
  95.   begin
  96.     if newstring='' then
  97.        exit;
  98.         {check for all spaces}
  99.         allspaces:=true;
  100.         letter:=1;
  101.         while ((allspaces) and (letter<=length(newstring))) do
  102.             if newstring[letter]<>' ' then
  103.                allspaces:=false
  104.         else
  105.             Inc(letter);
  106.         if allspaces=true then
  107.               newstring:=''
  108.         {check for leading, trailing blanks}
  109.           else
  110.             begin
  111.                letter:=1;
  112.                while newstring[letter]=#32 do
  113.                      Inc(letter);
  114.                newstring:=copy(newstring,letter,length(newstring)-letter+1);
  115.                letter:=length(newstring);
  116.                while newstring[letter]=#32 do
  117.                      Dec(letter);
  118.                newstring:=copy(newstring,1,letter);
  119.                {edit string for all lower case}
  120.         {edit string for all lower case}
  121.                newstring_byte_pointer:=@newstring;{effects
  122.                typscast of string
  123.                   to array of bytes}
  124.                for letter:=2 to newstring_byte_pointer^[1]+1 do
  125.                  if (newstring_byte_pointer^[letter] <91) and
  126.                     (newstring_byte_pointer^[letter] >64)
  127.                  then
  128.                    Inc(newstring_byte_pointer^[letter],32);
  129.            end{meat}
  130.  end{procedure editstring};
  131.  
  132.  
  133. function Lowercase(convert_string : string) :string;
  134.                          {converts a string to lowercase}
  135. var
  136.   letter :integer;
  137.   lengthofconvertstring : integer;
  138. begin
  139.   Lowercase:=convert_string;
  140.   if convert_string='' then exit;
  141.   lengthofconvertstring:=byte(convert_string[0]);
  142.   for letter:=1 to lengthofconvertstring do
  143.      if (convert_string[letter] <#91) and
  144.         (convert_string[letter] >#64) then
  145.         Lowercase[letter]:=chr(byte(convert_string[letter])+$20);
  146.  
  147. end;
  148.  
  149. {************end related service routines*************}
  150.  
  151.  
  152. {INTERNAL GLOBALS}
  153. type
  154.     kind_type=(UNKNOWN,NOTT,ORR,ANND,PRIMARY,BAD); {type of boolean binary
  155.                                                    infix operator,primary
  156.                                                     indicates a unary
  157.                                                      object}
  158.  
  159. var
  160.    {FOR ANYBOOL UNIT CODE}
  161.   op_str : array [1..3] of string[3];   {constants for divide procedure}
  162.   op_kind : array[1..3] of kind_type;{constants for divide procedure}
  163.   op_leng : array[1..3] of byte;
  164.  
  165.  work_string_interface_pass : string; {used ONLY to pass a string in and
  166.                                   out of obtain_hash_table procedure}
  167.  hash_user_target_string : string;
  168.  
  169.                         {actually used internally. would look something
  170.                          like '1 and 2 or (3 and not(1))' it is a boolean
  171.                          with the numbers refering to the index object in
  172.                            the hash table.}
  173.  
  174.  
  175.  
  176.  hash_table_formatted_0 : boolean;
  177.  
  178.  all_value_bit_mask : byte;
  179.                           {used to cycle through all possible boolean
  180.                              values of given user_target_string
  181.                                 object set.}
  182.  
  183.  
  184.    {**************************************}
  185.  
  186.    {ANYOOL UNIT CODE**********************}
  187.  
  188.    procedure remove_paren_and_edit(var boolean_work_string :
  189.                                                      string);
  190.        {THIS PRIMITIVE REMOVES OUTSIDE MATCHING SAME_LEVEL PARENTHESES
  191.         IF FOUND AND PARSES LEADING AND TRAILING BLANKS FROM
  192.         A STRING}
  193.        var
  194.          c1 : byte;
  195.          level : integer;
  196.          match : boolean;
  197.          leng  : byte;
  198.  
  199.  
  200.        BEGIN
  201. {empty string}if boolean_work_string='' then
  202.              begin
  203.              bool_validation_sit:=2;
  204.              exit
  205.              end;
  206.          {SCAN FOR VALID number left,right parentheses}
  207.          level:=0;
  208.          if ((Pos('(',boolean_work_string)=0) and
  209.              (Pos(')',boolean_work_string)=0)) then
  210.                level:=0
  211.          else
  212.          for c1:=1 to length(boolean_work_string) DO
  213.             begin
  214.              if boolean_work_string[c1]='(' then
  215.                     Inc(level)
  216.                   else if boolean_work_string[c1]=')' then
  217.                    begin
  218.                      Dec(level);
  219.                      if level<0 then level:=10000 {force bad}
  220.                    end;
  221.             end;
  222.  
  223.          if (level<>0)  then
  224.             begin
  225.               boolean_work_string:='';
  226.               bool_validation_sit:=2;
  227.               EXIT
  228.             end;
  229.  
  230.  
  231.  
  232.           {MEAT!}
  233.           match:=true;
  234.           Repeat
  235.  
  236.             Editstring(boolean_work_string);           {remove blanks tolower}
  237.             leng:=length(boolean_work_string);
  238.             c1:=1;
  239.             level:=0;
  240.  
  241.             if boolean_work_string='()' then           {empty parens}
  242.                begin
  243.                  boolean_work_string:='';
  244.                  bool_validation_sit:=2
  245.                end
  246.             else if leng=1 then
  247.                 match:=false
  248.             else
  249.             if leng=0 then                              {blanks or null
  250.                                                          in middle}
  251.                  begin
  252.                  match:=false;
  253.                  bool_validation_sit:=2;
  254.                  end
  255.             else
  256.               begin
  257.                 While ( (match) and (c1<=leng) and (bool_validation_sit<>2))
  258.                 DO
  259.                   BEGIN
  260.                   if ((c1=1) and (boolean_work_string[1]<>'(' ))
  261.                           then match:=false;
  262.                   if boolean_work_string[c1]='(' then Inc(level)
  263.                   else if boolean_work_string[c1]=')' then Dec(level);
  264.                   if ((match) and (level=1) and (c1=leng-1) and
  265.                       (boolean_work_string[c1+1]<>')' )) then
  266.                          match:=false
  267.                   else
  268.                   if ((level=0) and (c1>1) and (c1<leng)) then
  269.                        match:=false;                                {matched
  270.                                                                      parens
  271.                                                                      before
  272.                                                                      end}
  273.  
  274.                   INC(c1);
  275.                   END;
  276.                                                             {CHANGE STRING}
  277.                 if level<>0 then
  278.                   begin
  279.                   match:=false;
  280.                   bool_validation_sit:=2;
  281.                   end;
  282.                 if ((match) and (leng>=3))
  283.                   then
  284.                    boolean_work_string:=copy(boolean_work_string,2,
  285.                                            ord(boolean_work_string[0])-2);
  286.                END{ELSE};
  287.          Until ((not match) or (bool_validation_sit=2));
  288.             Editstring(boolean_work_string);
  289.  
  290.        END;{procedure remove_paren_and_edit}
  291.  
  292.   procedure divide_string(var user_boolean_string:string;var left_half :string;
  293.                       var right_half :string;var expression_kind :kind_type);
  294.        VAR
  295.          c1,letter :byte;
  296.          op_count : byte;
  297.          leng : byte; {op_l_leng is length of operator string name,
  298.                                leng is length of user_boolean_string}
  299.          level: integer;
  300.          op_l_leng : byte;
  301.   {kind_type=(UNKNOWN,NOTT,ORR,ANND,PRIMARY,BAD); type of boolean binary
  302.                                                    infix operator,primary
  303.                                                     indicates a unary
  304.                                                      object}
  305.  
  306.  
  307.        BEGIN
  308.          expression_kind:=UNKNOWN;
  309.  
  310.          op_count:=1;
  311.          leng:=length(user_boolean_string);
  312.  
  313.          {MAIN DETERMINE TYPE LOOP************************************}
  314.          WHILE ((expression_kind=UNKNOWN) and (op_count<=3) ) DO
  315.            BEGIN
  316.               op_l_leng:=op_leng[op_count];
  317.               letter:=1;
  318.               level:=0;
  319.               if leng>=op_l_leng then
  320.               While ((expression_kind=UNKNOWN)and
  321.                         (letter<= leng)) do
  322.                 begin
  323.                    if user_boolean_string[letter]=')' then
  324.                         Dec(level)
  325.                    else if user_boolean_string[letter]='(' then
  326.                         Inc(level)
  327.  
  328.  
  329.                    else if ((level=0) and
  330.                        (copy(user_boolean_string,letter,op_l_leng)=
  331.                       op_str[op_count])) then
  332.                         {---------------------------------------------------}
  333.                         if leng=op_l_leng then
  334.                              expression_kind:=BAD            {only operator}
  335.                         else
  336.                           if ((op_count<3) and (letter=1)    {and, or,}
  337.                                 and (user_boolean_string[letter+
  338.                                      op_l_leng] in
  339.                                           punct  ))
  340.                                   then
  341.                               expression_kind:=BAD          {operator starts}
  342.  
  343.                         else
  344.                           if ((letter=leng-op_l_leng+1) and
  345.                              (user_boolean_string[letter-1] in
  346.                                   punct  )) then
  347.                               expression_kind:=BAD             {operator ends}
  348.  
  349.                         else
  350.                           if ((letter>1) and (op_count<3) and
  351.                                   (letter<=leng-op_l_leng) and
  352.                             (user_boolean_string[letter-1] in
  353.                                   punct  ) and
  354.                             (user_boolean_string[letter+op_l_leng] in
  355.                                        punct  ))
  356.                              then
  357.                               begin
  358.                                expression_kind:=op_kind[op_count];
  359.                                left_half:=copy(user_boolean_string,1,
  360.                                                  letter-1);
  361.                                right_half:=copy(user_boolean_string,letter+
  362.                                                  op_l_leng,400);
  363.  
  364.                               end                             {valid or/ and}
  365.                           else
  366.                           if ((letter=1) and (op_count=3)
  367.                           and  (user_boolean_string[4] in
  368.                                  punct)) then
  369.                              begin
  370.                               expression_kind:=NOTT;            {valid not}
  371.                               left_half:=copy(user_boolean_string,4,
  372.                                                400);
  373.                               right_half:='';
  374.                              end;
  375.  
  376.                              {-----------------------------------------}
  377.                    Inc(letter);
  378.                 end{letter scan};
  379.  
  380.               Inc(op_count);
  381.            END{WHILE LOOP};
  382.          {END MAIN DETERMINE TYPE LOOP************************************}
  383.  
  384.          if expression_kind=UNKNOWN then
  385.               expression_kind:=PRIMARY;
  386.          if expression_kind=PRIMARY then
  387.                for c1:=1 to length(user_boolean_string) do
  388.                   if ((user_boolean_string[c1]='(' ) or
  389.                       (user_boolean_string[c1]=')' )
  390.                         or
  391.                     (copy(user_boolean_string,c1,5)=' not ')) then
  392.                         begin
  393.                           expression_kind:=BAD;
  394.                           left_half:='';
  395.                           right_half:='';
  396.  
  397.                         end;
  398.  
  399.         if expression_kind=BAD then
  400.              bool_validation_sit:=2{bad code};
  401.         if expression_kind=PRIMARY then
  402.               begin
  403.                left_half:=user_boolean_string;
  404.                right_half:='';
  405.               end;
  406.        END;{procedure divide_string}
  407.  
  408.  
  409.  
  410. {OBJECT FOR BOOL_INIT}
  411. {$F+}
  412. function obtain_hash_object :boolean;{object function passed by init_bool
  413.                                       to first_bool}
  414. {$F-}
  415.  
  416.      var
  417.         value_found: boolean;
  418.         counter :   letter_type;
  419.         found_0 :boolean;
  420.  
  421.      BEGIN
  422.        found_0:=false;
  423.        counter:='b';
  424.        if length_object_hash_table_0='a' then {FIRST VARIABLE NAME}
  425.          begin
  426.           length_object_hash_table_0:='b';
  427.           search_object_hash_table_0['b']:=
  428.                   work_string_interface_pass;
  429.           work_string_interface_pass:='b';
  430.           found_0:=true;
  431.          end;
  432.        if found_0=false then
  433.        while (counter<= length_object_hash_table_0)
  434.                  do
  435.           begin
  436.             if   (work_string_interface_pass
  437.                   = search_object_hash_table_0[counter])
  438.                    then
  439.                      begin
  440.                       found_0:=true;
  441.                       work_string_interface_pass :=counter;
  442.                      end;
  443.            counter:=succ(counter);
  444.          end;
  445.       if not found_0 then
  446.            if counter<='z' then    {NEW VARIABLE}
  447.               begin
  448.                search_object_hash_table_0[counter]:=
  449.                   work_string_interface_pass;
  450.                work_string_interface_pass:=counter;
  451.                length_object_hash_table_0:=
  452.                succ(length_object_hash_table_0);
  453.               end
  454.            else {TOO MANY VARIABLES}
  455.              begin
  456.                bool_validation_sit:=2;
  457.                work_string_interface_pass:='';
  458.                length_object_hash_table_0 :='a';{disable further init}
  459.                hash_user_target_string :='';{disable further init}
  460.             end;
  461.  
  462.      END;
  463.  
  464. {OBJECT FOR BOOL_INIT}
  465. {$F+}
  466. procedure for_all_boolean_values_object(var target_string :string;
  467.                                  var valid:boolean);
  468.  
  469.             {2nd object function passed by init_bool
  470.                                       to first_bool}
  471.      BEGIN
  472.         valid:= Pos(target_string,
  473. test_source_string)>0;
  474.      END;
  475. {$F-}
  476.  
  477.  
  478. {MAIN INTIALIZATION ENGINE}
  479.   function first_bool(var work_string :string;work_function
  480.                                            : hash_function_type) :boolean;
  481.     const
  482.       spc=' ';
  483.       not_spc='not ';
  484.     var
  485.      left_hlf,right_hlf : string;
  486.      bool_expression_kind_0 :kind_type;
  487.      left_result,right_result,dummy_result : boolean;
  488.      BEGIN
  489.       Inc(bool_recursion_depth_0);
  490.  
  491.                          {NOTE:bool_recursion_depth_0 is a counter
  492.                                   used to report
  493.                                   a 2-bad in
  494.                                    bool_validation_sit
  495.                                    if too many recursions involved}
  496.  
  497.  
  498.       if bool_recursion_depth_0 >max_bool_recursion_depth
  499.            then
  500.              bool_validation_sit:=2;
  501.       if bool_validation_sit=2 then
  502.         begin
  503.           first_bool:=false;
  504.           work_string:='';
  505.           length_object_hash_table_0 :='a';{disable further init}
  506.           hash_user_target_string :='';{disable further init}
  507.         end;
  508.  
  509.  
  510.  
  511.  
  512.       first_bool:=false;
  513.       bool_expression_kind_0 :=UNKNOWN;
  514.       bool_validation_sit:=0;
  515.       remove_paren_and_edit(work_string);
  516.      if bool_validation_sit<>2{bad} then
  517.        BEGIN
  518.         divide_string(work_string,left_hlf,right_hlf,
  519.                            bool_expression_kind_0 );
  520. {NOTE POSSIBLE RETURNS FROM DIVIDE ARE :UNKNOWN,NOTT,ORR,ANND,PRIMARY,BAD}
  521.  
  522.  
  523.          first_bool:=false;{fallthrough default}
  524. {****}   if bool_expression_kind_0=
  525. {****}     BAD  then
  526.                bool_validation_sit:=2{bad}
  527.          else if bool_expression_kind_0=
  528. {****}     ORR then {------WE WILL DIVIDE AND RECURSE!!!----}
  529. {****}                     BEGIN
  530.                              and_op:=false;
  531. {****}                       left_result:=first_bool(left_hlf,work_function);
  532.                              if bool_validation_sit<>2 then
  533.                              right_result:=first_bool(right_hlf,
  534. {****}                                                       work_function);
  535. {****}                       if bool_validation_sit=2 then
  536.                              else
  537.                              first_bool:=left_result or right_result;
  538. {****}                     END{divide select}
  539.             else if bool_expression_kind_0=
  540. {****}     ANND   then{------WE WILL DIVIDE AND RECURSE!!!----}
  541. {****}                     BEGIN
  542. {****}                       left_result:=first_bool(left_hlf,work_function);
  543.                              if bool_validation_sit<>2 then
  544.                              right_result:=first_bool(right_hlf,
  545. {****}                                                       work_function);
  546. {****}                       if bool_validation_sit=2 then
  547.                              else
  548.                              first_bool:=left_result and right_result;
  549. {****}                     END{divide select}
  550. {****}
  551. {****}
  552. {****}      else if bool_expression_kind_0=
  553.                   NOTT  then
  554.                       begin
  555.                         and_op:=false;
  556.                         or_op:=false;
  557.                         left_result:=not(first_bool(left_hlf,work_function));
  558.                         if bool_validation_sit=2 then
  559.                         else
  560.                           first_bool:=left_result;
  561.                         end
  562.                 else if bool_expression_kind_0=
  563. {****}            PRIMARY then
  564.                             begin
  565.  
  566.                               work_string:=left_hlf;
  567.                               work_string_interface_pass:=work_string;
  568.                                    {actually only needed for obtain_hash_object
  569.                                     first pass, but harmless otherwise}
  570.                               dummy_result:=work_function;
  571.                               if (not hash_table_formatted_0)
  572.                                   then
  573.                                     work_string:=work_string_interface_pass;
  574.                               if length(work_string)>1 then
  575.                                   bool_validation_sit:=2;
  576.                            end;
  577. {****}            {UNKNOWN : begin}
  578. {****}                     {Writeln('boolean program divide error');}
  579. {****}                     {halt}
  580. {****}
  581. {****}                     {end;}
  582. {****}
  583.           END{DIVIDE PART};
  584.       if bool_validation_sit=2 then      {no good code, then return
  585.                                              false}
  586.         begin
  587.           first_bool:=false;
  588.           work_string:='';
  589.           length_object_hash_table_0 :='a';{disable further init}
  590.           hash_user_target_string :='';{disable further init}
  591.         end
  592.  
  593.      ELSE {GOOD SO FAR-----------FORMAT RETURN SYMBOLIC BINARY INFIX}
  594.  
  595.           if bool_expression_kind_0 in
  596. {****}     [NOTT,ORR,ANND] then
  597.              {------WE WILL COMBINE STRING BINARY!!!----}
  598.                          begin
  599.                             if  bool_expression_kind_0=ANND then
  600.                                  if (length(left_hlf)+length(right_hlf)
  601.                                            +5<=255) then
  602.                                     work_string:='('+left_hlf+'and'+right_hlf+
  603.                                        ')'
  604.                                  else
  605.                                     bool_validation_sit:=2
  606.                             else
  607.                             if  bool_expression_kind_0=ORR then
  608.                                   if (length(left_hlf)+length(right_hlf)+
  609.                                      4<=255) then
  610.                                      work_string:='(' +left_hlf+'or'+right_hlf+
  611.                                         ')'
  612.                                   else
  613.                                      bool_validation_sit:=2
  614.                             else
  615.                             if  bool_expression_kind_0=NOTT then
  616.                                   if length(left_hlf)+6<=255 then
  617.                                      work_string:='('+ not_spc+left_hlf+')'
  618.                                   else
  619.                                      bool_validation_sit:=2;
  620.                        end
  621.            else if bool_expression_kind_0 =
  622.            PRIMARY then  work_string:=spc+work_string+spc;
  623.          {case return string symbolic binary formatting}
  624.  
  625.  
  626.  
  627.  
  628.      END{main initialization parser engine function};
  629.  
  630. function test_bool(var work_string :string;work_procedure
  631.  
  632.                                            : hash_procedure_type) :boolean;
  633.     {used for testing critical variables}
  634.     var
  635.      left_hlf,right_hlf : string;
  636.      bool_expression_kind_0 :kind_type;
  637.      left_result,right_result : boolean;
  638.      {FOR PASSING IN TO END_USER_PROCEDURE}
  639.      user_pass_in_string :string;
  640.      user_primary_search_result :boolean;
  641.  
  642.      BEGIN
  643.       test_bool:=false;
  644.        if bool_validation_sit=2 then exit;
  645.       Inc(bool_recursion_depth_0);
  646.  
  647.                          {NOTE:bool_recursion_depth_0 is a counter
  648.                                   used to report
  649.                                   a 2-bad in
  650.                                    bool_validation_sit
  651.                                    if too many recursions involved}
  652.  
  653.  
  654.  
  655.       bool_expression_kind_0 :=UNKNOWN;
  656.       remove_paren_and_edit(work_string);
  657.         divide_string(work_string,left_hlf,right_hlf,
  658.                            bool_expression_kind_0 );
  659. {NOTE POSSIBLE RETURNS FROM DIVIDE ARE :UNKNOWN,NOTT,ORR,ANND,PRIMARY,BAD}
  660.  
  661.  
  662. {****}   if bool_expression_kind_0 =
  663. {****}     PRIMARY then
  664.                       begin
  665.                              work_procedure(left_hlf,
  666.                                      user_primary_search_result);
  667.                              test_bool:=user_primary_search_result
  668.                     end
  669. {****}     else if bool_expression_kind_0=
  670. {****}     ORR then{------WE WILL DIVIDE AND RECURSE!!!----}
  671. {****}                       test_bool:=test_bool(left_hlf,work_procedure)
  672.                               or
  673. {****}                               test_bool(right_hlf,
  674.                                                      work_procedure)
  675. {****}
  676.            else if bool_expression_kind_0=
  677. {****}     ANND then
  678. {****}
  679.                 {------WE WILL DIVIDE AND RECURSE!!!----}
  680.                              test_bool:=test_bool(left_hlf,work_procedure)
  681.                               and
  682. {****}                               test_bool(right_hlf,
  683.                                                      work_procedure)
  684. {****}
  685. {****}
  686. {****}
  687.            else if bool_expression_kind_0=
  688. {****}     NOTT then
  689.                  test_bool:=not(test_bool(left_hlf,work_procedure));
  690. {****}
  691. {****}     {UNKNOWN : begin}
  692. {****}                   {Writeln('divide error');}
  693. {****}                    { halt}
  694. {****}
  695. {****}                     {end;}
  696. {****}
  697.  
  698.  
  699.  
  700.  
  701.      END{main active WE_HAVE_A_GO parser engine function};
  702.  
  703. procedure bool_init(user_boolean_string : string);
  704.   var
  705.     dummy : boolean;
  706.     all_bool_test_string:string;
  707.     generation_string:string;{used for critical true testing}
  708.     variable_add:letter_type;
  709.     true_once: boolean;
  710.    procedure determine_crit_true(
  711.             generation_string:string;var variable_add:letter_type);
  712.      {this SUB procedure tests all possible letter combinations of
  713.         our boolean for a possible truth value with test_letter
  714.         not present. therefore we can determine of a given variable
  715.         is not critical to the truth value of a boolean. The
  716.         bool_crit_true array has been initialized to all true before
  717.         first call to this}
  718.      var
  719.        pass_variable_add:letter_type;
  720.      begin
  721.        pass_variable_add:=Succ(variable_add);
  722.        if pass_variable_add > length_object_hash_table_0
  723.           then
  724.             begin
  725.              test_source_string:=generation_string;
  726.  
  727.            if   test_bool(all_bool_test_string,for_all_boolean_values_object)
  728.               =true then
  729.                  begin
  730.                   true_once:=true; {our expression is true at least once}
  731.                   if Pos(critical_test_letter,generation_string)=0 then
  732.                      bool_crit_true[critical_test_letter]:=false;
  733.                      {a given variable is not critical}
  734.                  end
  735.             end
  736.           else
  737.              begin
  738.  
  739.                determine_crit_true(generation_string,
  740.                            pass_variable_add);
  741.  
  742.                generation_string:=generation_string+pass_variable_add;
  743.                determine_crit_true(generation_string,
  744.                            pass_variable_add);
  745.                 end;
  746.  
  747.  
  748.      end;
  749.  
  750.  
  751.   BEGIN {MAINLINE PROCEDURE BOOL_INIT}
  752.      and_op:=true;
  753.      or_op:=true;
  754.      true_once:=false;
  755.      bool_validation_sit:=1;{default good until proven otherwise}
  756.      if user_boolean_string='' then
  757.           bool_validation_sit:=2;
  758.      {INITIALIZE OPERATORS FOR DIVIDE PROCEDURE}
  759.          op_str[1] :='or';
  760.          op_kind[1]:=ORR;
  761.          op_leng[1]:=2;
  762.          op_str[2] :='and';
  763.          op_kind[2]:=ANND;
  764.          op_leng[2]:=3;
  765.          op_str[3] :='not';
  766.          op_kind[3]:=NOTT;
  767.          op_leng[3]:=3;
  768.  
  769.      bool_validation_sit:=1;{default good until proven otherwise}
  770.      length_object_hash_table_0 :='a';{will be table of symbolic objects}
  771.      bool_recursion_depth_0 :=0;{counter used to report
  772.                                   a 2-bad in
  773.                                    bool_validation_sit
  774.                                    if too many recursions involved}
  775.      hash_table_formatted_0:=false;
  776.      dummy:=first_bool(user_boolean_string,obtain_hash_object);
  777.      if bool_validation_sit<>2 then
  778.          hash_user_target_string:=user_boolean_string;
  779.  
  780.  {NOTE USER_BOOLEAN UNIT COPY HAS NOW BEEN TRANSFORMED if sit code
  781.         <>2 to a symbolic string 'a or b and c' for ex.}
  782.  
  783.  
  784.      bool_recursion_depth_0 :=0;
  785.      hash_table_formatted_0:=true; {important bug flag}
  786.      all_bool_test_string:=hash_user_target_string;
  787.  
  788.      {initialize bool crit list}
  789.      if bool_validation_sit<>2 then
  790.      for critical_test_letter:='b' to length_object_hash_table_0 do
  791.         bool_crit_true[critical_test_letter]:=true;
  792.  
  793.      if bool_validation_sit=2 {bad} then
  794.  
  795.           begin
  796.             length_object_hash_table_0 :='a';{disable further init}
  797.             hash_user_target_string :='';{disable further init}
  798.           end
  799.      ELSE
  800.        begin
  801.       {determine bool_crit_true array of variables}
  802.                 for critical_test_letter:='b' to length_object_hash_table_0 do
  803.        if length_object_hash_table_0< 'g' then
  804.  
  805.           begin
  806.           generation_string:='a';
  807.           variable_add:='a';
  808.           determine_crit_true(generation_string,
  809.             variable_add);
  810.           end
  811.         else
  812.            begin
  813.              bool_crit_true[critical_test_letter]:=false;
  814.              true_once:=true;
  815.            end;
  816.         if (bool_validation_sit <>2) and (not true_once)
  817.             then bool_validation_sit:=4;
  818.           end;
  819.  
  820.   END{procedure init_bool};
  821.  
  822.  
  823. function bool(var work_string :string;work_procedure
  824.  
  825.                                            : hash_procedure_type) :boolean;
  826.     var
  827.      left_hlf,right_hlf : string;
  828.      bool_expression_kind_0 :kind_type;
  829.      left_result,right_result : boolean;
  830.      {FOR PASSING IN TO END_USER_PROCEDURE}
  831.      user_pass_in_string :string;
  832.      user_primary_search_result :boolean;
  833.  
  834.      BEGIN
  835.       bool:=false;
  836.        if bool_validation_sit=2 then exit;
  837.       Inc(bool_recursion_depth_0);
  838.  
  839.                          {NOTE:bool_recursion_depth_0 is a counter
  840.                                   used to report
  841.                                   a 2-bad in
  842.                                    bool_validation_sit
  843.                                    if too many recursions involved}
  844.  
  845.  
  846.  
  847.       bool_expression_kind_0 :=UNKNOWN;
  848.       remove_paren_and_edit(work_string);
  849.         divide_string(work_string,left_hlf,right_hlf,
  850.                            bool_expression_kind_0 );
  851. {NOTE POSSIBLE RETURNS FROM DIVIDE ARE :UNKNOWN,NOTT,ORR,ANND,PRIMARY,BAD}
  852.  
  853.  
  854. {****}   if bool_expression_kind_0 =
  855. {****}     PRIMARY then
  856.                       begin
  857.                              user_pass_in_string:=
  858.                              search_object_hash_table_0[left_hlf[1]];
  859.                              work_procedure(user_pass_in_string,
  860.                                      user_primary_search_result);
  861.                              bool:=user_primary_search_result
  862.                     end
  863. {****}     else if bool_expression_kind_0=
  864. {****}     ORR then{------WE WILL DIVIDE AND RECURSE!!!----}
  865. {****}                       bool:=bool(left_hlf,work_procedure)
  866.                               or
  867. {****}                               bool(right_hlf,
  868.                                                      work_procedure)
  869. {****}
  870.            else if bool_expression_kind_0=
  871. {****}     ANND then
  872. {****}
  873.                 {------WE WILL DIVIDE AND RECURSE!!!----}
  874.                              bool:=bool(left_hlf,work_procedure)
  875.                               and
  876. {****}                               bool(right_hlf,
  877.                                                      work_procedure)
  878. {****}
  879. {****}
  880. {****}
  881.            else if bool_expression_kind_0=
  882. {****}     NOTT then
  883.                  bool:=not(bool(left_hlf,work_procedure));
  884. {****}
  885. {****}     {UNKNOWN : begin}
  886. {****}                   {Writeln('divide error');}
  887. {****}                    { halt}
  888. {****}
  889. {****}                     {end;}
  890. {****}
  891.  
  892.  
  893.  
  894.  
  895.      END{main active WE_HAVE_A_GO parser engine function};
  896.  
  897.  
  898. function any_bool(user_defined_procedure : hash_procedure_type) :boolean;
  899.   begin
  900.     any_bool:=false;
  901.     if bool_validation_sit=2 then
  902.          exit;
  903.     any_bool:=bool
  904.              (hash_user_target_string,user_defined_procedure);
  905.  
  906.  
  907.   end;{function shell any_bool}
  908.  
  909. {INITIALIZATION}
  910. begin
  911. max_bool_recursion_depth:=24;
  912. bool_validation_sit:=100;
  913.  
  914.  
  915. end.{unit seabool}
  916.  
  917.